home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / ilisp / ilisp-utl.el < prev    next >
Encoding:
Text File  |  1995-01-26  |  3.7 KB  |  129 lines
  1. ;;; -*- Mode: Emacs-Lisp -*-
  2.  
  3. ;;; ilisp-utl.el --
  4.  
  5. ;;; This file is part of ILISP.
  6. ;;; Version: 5.7
  7. ;;;
  8. ;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell
  9. ;;;               1993, 1994 Ivan Vasquez
  10. ;;;               1994, 1995 Marco Antoniotti and Rick Busdiecker
  11. ;;;
  12. ;;; Other authors' names for which this Copyright notice also holds
  13. ;;; may appear later in this file.
  14. ;;;
  15. ;;; Send mail to 'ilisp-request@lehman.com' to be included in the
  16. ;;; ILISP mailing list. 'ilisp@lehman.com' is the general ILISP
  17. ;;; mailing list were bugs and improvements are discussed.
  18. ;;;
  19. ;;; ILISP is freely redistributable under the terms found in the file
  20. ;;; COPYING.
  21.  
  22.  
  23.  
  24. ;;;
  25. ;;; ILISP misc tools.
  26. ;;;
  27.  
  28. (defun lisp-show-send (string)
  29.   "Show STRING in the *ilisp-send* buffer."
  30.   (save-excursion
  31.     (if (ilisp-buffer)
  32.     (set-buffer "*ilisp-send*")
  33.     (error "You must start an inferior LISP with run-ilisp."))
  34.     (erase-buffer)
  35.     (insert string)
  36.     string))
  37.  
  38.  
  39. ;;;
  40. (defun lisp-slashify (string)
  41.   "Put string in the *ilisp-send* buffer, put backslashes before
  42. quotes and backslashes and return the resulting string."
  43.   (save-excursion
  44.     (lisp-show-send string)
  45.     (set-buffer "*ilisp-send*")
  46.     (goto-char (point-min))
  47.     (while (search-forward "\\" nil t)
  48.       (delete-char -1)
  49.       (insert "\\\\"))
  50.     (goto-char (point-min))
  51.     (while (search-forward "\"" nil t)
  52.       (backward-char)
  53.       (insert ?\\)
  54.       (forward-char))
  55.     (buffer-substring (point-min) (point-max))))
  56.  
  57.  
  58. ;;;%%String
  59. (defun lisp-prefix-p (s1 s2)
  60.   "Returns t if S1 is a prefix of S2 considering all non alphanumerics
  61. as word delimiters."
  62.   (let ((len1 (length s1)))
  63.     (and (<= len1 (length s2))
  64.      (let ((start 0)
  65.            (start2 0) 
  66.            end
  67.            (match t))
  68.        (while
  69.            (if (setq end (string-match "[^a-zA-Z0-9]" s1 start))
  70.            ;; Found delimiter
  71.            (if (string= (substring s1 start end)
  72.             (substring s2 start2 (+ start2 (- end start))))
  73.                ;; Words are the same
  74.                (progn (setq start (match-end 0))
  75.                   (if (string-match
  76.                    (regexp-quote (substring s1 end start))
  77.                    s2 start2)
  78.                   (setq start2 (match-end 0)) ;OK
  79.                 (setq match nil))) ;Can't find delimiter
  80.              (setq match nil))    ;Words don't match 
  81.          nil))            ;Ran out of delimiters in s1
  82.        (and match
  83.         (string= (substring s1 start len1)
  84.          (substring s2 start2 (+ start2 (- len1 start)))))))))
  85.  
  86.  
  87. ;;;
  88. (defun lisp-last-line (string)
  89.   "Return the last line of STRING with everything else."
  90.   (let* ((position 0))
  91.     (while (string-match "\\(\n+\\)[^\n]" string position)
  92.       (setq position (match-end 1)))
  93.     (cons (substring string position)
  94.       (substring string 0 position))))
  95.  
  96.  
  97. ;;;%%File
  98. ;;;
  99. (defun lisp-file-extension (file extension)
  100.   "Return FILE with new EXTENSION."
  101.   (concat (substring file 0 (string-match ".[^.]*$" file))
  102.       "." extension))
  103.  
  104. (defun ilisp-directory (file &optional dirs)
  105.   "Return the directory of DIRS that FILE is found in.  By default
  106. load-path is used for the directories."
  107.   (let* ((dirs (or dirs (cons "" load-path)))
  108.      (dir (car dirs)))
  109.     (while (and dir (not (file-exists-p (expand-file-name file dir))))
  110.       (setq dirs (cdr dirs)
  111.         dir (car dirs)))
  112.     dir))
  113.  
  114.  
  115. ;;; ilisp-update-status --
  116. ;;;
  117. ;;; Note: changed in order to propagate the status change in the
  118. ;;;       underlying process to the menu.
  119.  
  120. (defun ilisp-update-status (status)
  121.   "Update process STATUS of the whole Ilisp system.
  122. It updates the STATUS of the current buffer and let all lisp mode
  123. buffers know as well.  Also, do some 'exterior' things like make sure
  124. that the menubar is in a consistent state."
  125.   (setq ilisp-status (if lisp-show-status (format " :%s" status)))
  126.   (if (not (member +ilisp-emacs-version-id+ '(xemacs lucid-19 lucid-19-new)))
  127.       (ilisp-update-menu status))
  128.   (comint-update-status status))
  129.